# start by creating cluster subsets
#subset values
deeper <- cluster %>% 
  filter(proposed_cluster_for_preliminary_24_analysis == "Deeper learning") %>% 
  select(label = tag) %>% 
  left_join(labels, by = "label") %>% 
  pull(var)
ed_justice <- cluster %>% 
  filter(proposed_cluster_for_preliminary_24_analysis == "Ed justice") %>% 
  select(label = tag) %>% 
  left_join(labels, by = "label") %>% 
  pull(var)
individualized <- cluster %>% 
  filter(proposed_cluster_for_preliminary_24_analysis == "Individualized") %>% 
  select(label = tag) %>% 
  left_join(labels, by = "label") %>% 
  pull(var)
postsecondary <- cluster %>% 
  filter(proposed_cluster_for_preliminary_24_analysis == "Postsecondary") %>% 
  select(label = tag) %>% 
  left_join(labels, by = "label") %>% 
  pull(var)
none <- cluster %>%
  filter(proposed_cluster_for_preliminary_24_analysis == "None" |
           proposed_cluster_for_preliminary_24_analysis == "None?") %>%
  select(label = tag) %>%
  left_join(labels, by = "label") %>%
  pull(var)
### DATA FUNCTIONS ###
#set up repeating schools - 2+ years
repeaters_2 <- dat %>% 
  select(school_id, year) %>% 
  unique() %>% 
  mutate(rate = 1) %>% 
  pivot_wider(names_from = "year",
              values_from = "rate") %>% 
  rowwise() %>% 
  mutate(participate = sum(`2019`, `2021`, `2022`, `2023`, `2024`, na.rm = TRUE)) %>% 
  filter(participate > 1) %>% 
  pull(school_id)
#set up repeating schools - 3+ years
repeaters_3 <- dat %>% 
  select(school_id, year) %>% 
  unique() %>% 
  mutate(rate = 1) %>% 
  pivot_wider(names_from = "year",
              values_from = "rate") %>% 
  rowwise() %>% 
  mutate(participate = sum(`2019`, `2021`, `2022`, `2023`, `2024`, na.rm = TRUE)) %>% 
  filter(participate > 2) %>% 
  pull(school_id)
#set up repeating schools - all years
repeaters_all <- dat %>% 
  select(school_id, year) %>% 
  unique() %>% 
  mutate(rate = 1) %>% 
  pivot_wider(names_from = "year",
              values_from = "rate") %>% 
  rowwise() %>% 
  mutate(participate = sum(`2019`, `2021`, `2022`, `2023`, `2024`, na.rm = TRUE)) %>% 
  filter(participate == 5) %>% 
  pull(school_id)
#set up totals 
tots <- dat %>% 
  group_by(year) %>% 
  summarize(total = n_distinct(school_id))
tots_2 <- dat %>% 
  filter(school_id %in% repeaters_2) %>% 
  group_by(year) %>% 
  summarize(total = n_distinct(school_id))
tots_3 <- dat %>% 
  filter(school_id %in% repeaters_3) %>% 
  group_by(year) %>% 
  summarize(total = n_distinct(school_id))
tots_all <- dat %>% 
  filter(school_id %in% repeaters_all) %>% 
  group_by(year) %>% 
  summarize(total = n_distinct(school_id))
#set up 3+ year tags
rep_tags <- dat %>% 
  group_by(var) %>% 
  summarize(num_years = n_distinct(year)) %>% 
  ungroup() %>% 
  filter(num_years >= 3) %>% 
  select(var) %>% 
  unique() %>% 
  pull(var)
#prep data function across schools
prep_across <- function(data, cluster){
  dat <- data %>% 
    filter(var %in% cluster) %>% 
    group_by(var, year) %>% 
    summarize(n = sum(usage)) %>% 
    ungroup() %>% 
    left_join(tots, by = "year") %>% 
    mutate(pct = n/total) %>% 
    left_join(labels, by = "var") %>% 
    group_by(var) %>% 
    mutate(x_coord = max(year),
           y_coord = pct[which.max(year)])
  
  return(dat)
}
#prep data function within schools
prep_within <- function(data, cluster){
  dat <- data %>% 
    filter(var %in% cluster) %>% 
    filter(school_id %in% repeaters_2) %>% 
    arrange(school_id, year) %>% 
    group_by(school_id) %>%
    mutate(wave = dense_rank(year)) %>% 
    ungroup() %>% 
    arrange(school_id, year) %>%
    group_by(school_id, var) %>%
    mutate(change = usage - lag(usage)) %>% 
    ungroup() %>% 
    mutate(adds = ifelse(change == 1, 1, NA),
           drops = ifelse(change == -1, 1, NA)) %>% 
    group_by(var, year) %>% 
    summarize(`Overall rate` = sum(usage, na.rm = TRUE),
              `Average change` = sum(change, na.rm = TRUE),
              Adds = sum(adds, na.rm = TRUE),
              Drops = sum(drops, na.rm = TRUE)) %>% 
    ungroup() %>% 
    pivot_longer(cols = c(`Overall rate`, `Average change`, Adds, Drops),
                 names_to = "type",
                 values_to = "n") %>% 
    left_join(labels, by = "var") %>% 
    mutate(type = factor(type, levels = c("Overall rate", "Average change", "Adds", "Drops"))) %>% 
    #3.27.24 modification = remove 2019 & only present adds/drops
    filter(year > 2019, type == "Adds" | type == "Drops")
    return(dat)
}
#prep data function overall pct
prep_overall <- function(data, cluster, group, total){
  dat <- data %>% 
    filter(var %in% cluster) %>% 
    filter(school_id %in% group) %>% 
    group_by(var, year) %>% 
    summarize(n = sum(usage, na.rm = TRUE)) %>% 
    ungroup() %>% 
    left_join(total, by = "year") %>% 
    mutate(pct = n/total) %>% 
    left_join(labels, by = "var") %>% 
    group_by(var) %>% 
    mutate(x_coord = max(year),
           y_coord = pct[which.max(year)])

    return(dat)
}
prep_net <- function(data){
  data <- data %>% 
    pivot_wider(names_from = type,
                values_from = n) %>%
    group_by(var) %>% 
    mutate(net = Adds - Drops) %>% 
    ungroup() %>% 
    left_join(tots, by = "year") %>% 
    group_by(year, var, label) %>% 
    summarize(norm_net = net/total) %>% 
    ungroup() %>% 
    group_by(var) %>% 
    mutate(cum_norm_net = mean(norm_net)) %>% #average net change over time
    ungroup() %>% 
    mutate(type = case_when(
      cum_norm_net == max(cum_norm_net) ~ "Largest net change over time",
      cum_norm_net == min(cum_norm_net) ~ "Smallest net change over time",
      TRUE ~ "Average net change"
    ),
    type = factor(type, levels = c("Largest net change over time", "Smallest net change over time", "Average net change"))) #specify order for palette
}
prep_net_3 <- function(data){
  data <- data %>% 
    filter(var %in% rep_tags) %>% 
    mutate(max_cum = max(cum_norm_net),
           min_cum = min(cum_norm_net)) %>% 
  group_by(var) %>% 
  mutate(type = case_when(
         max_cum == cum_norm_net ~ "Largest net change over time",
         min_cum == cum_norm_net ~ "Smallest net change over time",
         TRUE ~ "Average net change"),
         type = factor(type, levels = c("Largest net change over time", "Smallest net change over time", "Average net change")))
}
### PLOT FUNCTIONS ###
#plot function for across schools
cluster_plot_across <- function(data, x, y, labels) {
  #palette <- c("#BC2582", "#FFA630", "#FFDE42", "#99C24D", "#218380", "#D3B7D7")
  data <- data %>% 
    mutate(wrapped_label = str_wrap(get(labels), 40))
  
  labels <- data %>%
    select(label = wrapped_label, x_coord, y_coord) %>%
    unique()

  plot <- ggplot(data, aes_string(x = x, y = y, color = "label")) +
    geom_point() +
    geom_line() +
    theme_bw() +
    scale_x_continuous(limits = c(2019, 2027),
                       expand = c(0.01, 0.5),
                       breaks = unique(data$year)) + #expand 0.025, .3
    scale_y_continuous(limits = c(0, 1),
                       expand = c(0, 0),
                       labels = scales::percent_format(accuracy = 1)) +
    theme(legend.position = "none") +
    geom_text_repel(data = labels,
                    aes(label = label, x = x_coord, y = y_coord),
                    nudge_x = 0.5,
                    direction = "y",
                    size = 3,
                    box.padding = 0.3,
                    point.padding = 2
                    )
  
  return(plot)
}

cluster_plot_within <- function(data, facet) { #data, x, y, facet, group
  plot <- ggplot(data, aes_string(x = "year", y = "n")) + #aes_string(x = x, y = y, text = group)
    geom_line(aes(group = label), color = "gray", alpha = 0.5) + #group = group
    geom_point(aes(group = label), color = "gray", alpha = 0.5, size = 1) + #group = group
    geom_smooth(se = FALSE, method = "lm", color = "cornflowerblue", aes(group = 1)) + 
    #straight line before
    #geom_smooth(method = "lm", se = FALSE, color = "blue", aes(group = 1)) +
    theme_bw() +
    scale_x_continuous(name = "Year", expand = expansion(mult = c(.025, .3))) +
    theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), legend.position = "none") +
    facet_wrap(as.formula(paste0("~", facet))) #+  #, scales = "free_y"
    #labs(x = x, y = y)

  return(plot)
}
net_change_plot <- function(data){
  palette <- c("#6cac8c", "#ff6f69","#d3d3d3")
  
  plot <- ggplot(data, aes(year, norm_net, color = type, group = var, text = label)) +
    geom_line(alpha = 0.8) +
    geom_point(alpha = 0.5, size = 1) +
    scale_color_manual(values = palette) +
    theme_bw() +
    theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), legend.position = "none") +
    scale_x_continuous(expand = expansion(mult = c(0, 0))) +
    scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
    labs(x = "", y = "Normalized net change",
         subtitle = "Values above the dashed line indicate growth. Values below the dashed line indicate decline.") +
    geom_hline(aes(yintercept = 0), size = .25, linetype = "dashed")
  
  interactive <- ggplotly(plot, tooltip = c("year", "norm_net", "label"))
  
  return(interactive)
}
#try plotly
#across plot
fancy_across <- function(data){
  plot <- plot_ly(data, x = ~year, y = ~pct, type = 'scatter', mode = 'lines+markers', text = ~label, hoverinfo = 'text+y') %>% 
    layout(yaxis = list(tickformat = ".0%"))
  return(plot)
}

Deeper Learning Cluster

Tags:
- assessments for deeper learning
- competency/mastery-based education
- competency framework
- design thinking process
- interdisciplinary
- makerspace
- multiple opportunities to demonstrate mastery
- project-based learning
- performance based assessment
- place-based learning
- student-led conferences
- students develop projects

Guiding question: How have the rates of deeper learning tags changed each year since 2019?

Across schools

deep <- prep_across(dat, deeper)
#cluster_plot_across(deep, "year", "pct", "label")
fancy_across(deep)

Within schools

Overall rate among repeat schools (2+ years):

deep <- prep_overall(dat, deeper, repeaters_2, tots_2)
#cluster_plot_across(deep, "year", "pct", "label")
fancy_across(deep)

Overall rate among repeat schools (3+ years):

deep <- prep_overall(dat, deeper, repeaters_3, tots_3)
fancy_across(deep)

Overall rate among repeat schools (5 years):

deep <- prep_overall(dat, deeper, repeaters_all, tots_all)
fancy_across(deep)
deep <- prep_within(dat, deeper)
plot <- cluster_plot_within(deep, "type") #deep, deep$year, deep$n, "type", deep$label
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
suppressWarnings({ggplotly(plot)})

Net change

In the following graph I used net change (Adds - Drops) to calculate the rate of change for each tag. I then created a cumulative rate for each tag (average across years) to identify the highest and lowest rates of change in the cluster. The highest rate of change is colored in green and the lowest rate of change in red.

Note these plots are interactive–if you’re curious about a particular line you can hover over one of it’s points to see which tag it corresponds to.

deep <- prep_net(deep)
net_change_plot(deep)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: `gather_()` was deprecated in tidyr 1.2.0.
## ℹ Please use `gather()` instead.
## ℹ The deprecated feature was likely used in the plotly package.
##   Please report the issue at <https://github.com/plotly/plotly.R/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Net change 3+ year tags

deep <- prep_net_3(deep)
net_change_plot(deep)

Educational Justice Cluster

Tags:
- adult wellness/SEL
- anti-racist practices
- assessments for social-emotional skills
- teachers as co-leaders
- co-leadership
- family and community support services
- culturally responsive practices
- design to meet needs of students who have been marginalized
- hiring for equity and inclusion values
- all courses designed for inclusion
- mental health services
- physical well being services
- reallocation of resources for those most in need
- restorative practices
- SEL curriculum
- SEL integration school-wide
- social justice focus
- translanguaging
- trauma-informed practices

Across schools

justice_dat <- prep_across(dat, ed_justice)
fancy_across(justice_dat)

Within schools

Overall rate among repeat schools (2+ years):

justice_dat <- prep_overall(dat, ed_justice, repeaters_2, tots_2)
fancy_across(justice_dat)

Overall rate among repeat schools (3+ years):

justice_dat <- prep_overall(dat, ed_justice, repeaters_3, tots_3)
fancy_across(justice_dat)

Overall rate among repeat schools (all years):

justice_dat <- prep_overall(dat, ed_justice, repeaters_all, tots_all)
fancy_across(justice_dat)
justice_dat <- prep_within(dat, ed_justice)
plot <- cluster_plot_within(justice_dat, "type")
suppressWarnings({ggplotly(plot)})

Net change

justice_dat <- prep_net(justice_dat)
net_change_plot(justice_dat)

Net change 3+ year tags

justice_dat <- prep_net_3(justice_dat)
net_change_plot(justice_dat)

Individualized Cluster

Tags:
- accommodations provided to all students
- blended learning
- flex model
- flipped classroom
- interoperable data from multiple technologies
- 1:1 mentoring
- station rotation
- students access their own data
- self-paced learning

Across schools

ind_dat <- prep_across(dat, individualized)
fancy_across(ind_dat)

Within schools

Overall rate among repeat schools (2+ years):

ind_dat <- prep_overall(dat, individualized, repeaters_2, tots_2)
fancy_across(ind_dat)

Overall rate among repeat schools (3+ years):

ind_dat <- prep_overall(dat, individualized, repeaters_3, tots_3)
fancy_across(ind_dat)

Overall rate among repeat schools (all years):

ind_dat <- prep_overall(dat, individualized, repeaters_3, tots_3)
fancy_across(ind_dat)
ind_dat <- prep_within(dat, individualized)
plot <- cluster_plot_within(ind_dat, "type")
suppressWarnings({ggplotly(plot)})

Net change

ind_dat <- prep_net(ind_dat)
net_change_plot(ind_dat)

Net change 3+ year tags

ind_dat <- prep_net_3(ind_dat)
net_change_plot(ind_dat)

Postsecondary Cluster

Tags:
- à la carte model
- assessments for career readiness
- career prep and work-based learning
- community-based organizations as co-leaders
- industry-based partners as co-leaders
- community and business partnerships
- early college high school
- extended learning opportunities
- students earn industry credentials

Across schools

post_dat <- prep_across(dat, postsecondary)
fancy_across(post_dat)

Within schools

Overall rate among repeat schools (2+ years):

post_dat <- prep_overall(dat, postsecondary, repeaters_2, tots_2)
fancy_across(post_dat)

Overall rate among repeat schools (3+ years):

post_dat <- prep_overall(dat, postsecondary, repeaters_3, tots_3)
fancy_across(post_dat)

Overall rate among repeat schools (all years):

post_dat <- prep_overall(dat, postsecondary, repeaters_all, tots_all)
fancy_across(post_dat)
post_dat <- prep_within(dat, postsecondary)
plot <- cluster_plot_within(post_dat, "type")
suppressWarnings({ggplotly(plot)})

Net change

post_dat <- prep_net(post_dat)
net_change_plot(post_dat)

Net change 3+ year tags

post_dat <- prep_net_3(post_dat)
net_change_plot(post_dat)

High Schools only

# set up data prep
# ID high schools
hs <- import(here("data/longitudinal", "longitudinal_data.csv")) %>% 
  select(school_id, grades_high) %>% 
  filter(grades_high == 1) %>% 
  pull(school_id)
#set up repeating schools
hs_repeaters <- dat %>% 
  filter(school_id %in% hs) %>% 
  select(school_id, year) %>% 
  unique() %>% 
  mutate(rate = 1) %>% 
  pivot_wider(names_from = "year",
              values_from = "rate") %>% 
  rowwise() %>% 
  mutate(participate = sum(`2019`, `2021`, `2022`, `2023`, `2024`, na.rm = TRUE)) %>% 
  filter(participate > 1) %>% 
  pull(school_id)
#set up totals 
hs_tots <- dat %>% 
  filter(school_id %in% hs) %>% 
  group_by(year) %>% 
  summarize(total = n_distinct(school_id)) %>% 
  unique()
#prep data across schools
hs_across <- dat %>% 
  filter(school_id %in% hs) %>% 
    filter(var %in% postsecondary) %>% 
    group_by(var, year) %>% 
    summarize(n = sum(usage)) %>% 
    ungroup() %>% 
    left_join(hs_tots, by = "year", relationship = "many-to-many") %>% 
    mutate(pct = n/total) %>% 
    left_join(labels, by = "var") %>% 
    group_by(var) %>% 
    mutate(x_coord = max(year),
           y_coord = pct[which.max(year)])
#prep data within schools
hs_within <- dat %>% 
  filter(school_id %in% hs) %>% 
    filter(var %in% postsecondary) %>% 
    filter(school_id %in% hs_repeaters) %>% 
    arrange(school_id, year) %>% 
    group_by(school_id) %>%
    mutate(wave = dense_rank(year)) %>% 
    ungroup() %>% 
    arrange(school_id, year) %>%
    group_by(school_id, var) %>%
    mutate(change = usage - lag(usage)) %>% 
    ungroup() %>% 
    mutate(adds = ifelse(change == 1, 1, NA),
           drops = ifelse(change == -1, 1, NA)) %>% 
    group_by(var, year) %>% 
    summarize(`Overall rate` = sum(usage, na.rm = TRUE),
              `Average change` = sum(change, na.rm = TRUE),
              Adds = sum(adds, na.rm = TRUE),
              Drops = sum(drops, na.rm = TRUE)) %>% 
    ungroup() %>% 
    pivot_longer(cols = c(`Overall rate`, `Average change`, Adds, Drops),
                 names_to = "type",
                 values_to = "n") %>% 
    left_join(labels, by = "var") %>% 
    mutate(type = factor(type, levels = c("Overall rate", "Average change", "Adds", "Drops"))) %>% 
    #3.27.24 modification = remove 2019 & only present adds/drops
    filter(year > 2019, type == "Adds" | type == "Drops")
#prep data overall pct
hs_overall <- dat %>% 
    filter(var %in% postsecondary) %>% 
    filter(school_id %in% hs_repeaters) %>% 
    group_by(var, year) %>% 
    summarize(n = sum(usage, na.rm = TRUE)) %>% 
    ungroup() %>% 
    left_join(hs_tots, by = "year") %>% 
    mutate(pct = n/total) %>% 
    left_join(labels, by = "var") %>% 
    group_by(var) %>% 
    mutate(x_coord = max(year),
           y_coord = pct[which.max(year)])

Across high schools

fancy_across(hs_across)

Within high schools

Overall rate among repeat high schools (2+ years):

fancy_across(hs_overall)
plot <- cluster_plot_within(hs_within, "type")
suppressWarnings({ggplotly(plot)})

Net change

hs_within <- prep_net(hs_within)
net_change_plot(hs_within)

Net change 3+ year tags

hs_within <- prep_net_3(hs_within)
net_change_plot(hs_within)

None tags

Across schools

none_dat <- prep_across(dat, none)
fancy_across(none_dat)

Within schools

Overall rate among repeat schools (2+ years):

none_dat <- prep_overall(dat, none, repeaters_2, tots_2)
fancy_across(none_dat)

Overall rate among repeat schools (3+ years):

none_dat <- prep_overall(dat, none, repeaters_3, tots_3)
fancy_across(none_dat)

Overall rate among repeat schools (all years):

none_dat <- prep_overall(dat, none, repeaters_all, tots_all)
fancy_across(none_dat)
none_dat <- prep_within(dat, none)
plot <- cluster_plot_within(none_dat, "type")
suppressWarnings({ggplotly(plot)})

Net change

none_dat <- prep_net(none_dat)
net_change_plot(none_dat)

Net change 3+ year tags

none_dat <- prep_net_3(none_dat)
net_change_plot(none_dat)

Blended Learning Cluster

Reminder: This cluster is separate from the analysis - this was a starting point.

Tags: - blended learning
- à la carte model
- flipped classroom
- flex model
- enriched virtual model
- station rotation

Across schools

# subset tags
blended_tags <- c("practices_blended_learning", "practices_a_la_carte", "practices_flipped_classroom", "practices_flex", "practices_enriched_virtual", "practices_station_rotation")
blend_dat <- prep_across(dat, blended_tags)
fancy_across(blend_dat)

Within schools

Overall rate among repeat schools (2+ years):

blend_dat <- prep_overall(dat, blended_tags, repeaters_2, tots_2)
fancy_across(blend_dat)

Overall rate among repeat schools (3+ years):

blend_dat <- prep_overall(dat, blended_tags, repeaters_3, tots_3)
fancy_across(blend_dat)

Overall rate among repeat schools (all years):

blend_dat <- prep_overall(dat, blended_tags, repeaters_all, tots_all)
fancy_across(blend_dat)
blend_dat <- prep_within(dat, blended_tags)
plot <- cluster_plot_within(blend_dat, "type")
suppressWarnings({ggplotly(plot)})

Net change

blend_dat <- prep_net(blend_dat)
net_change_plot(blend_dat)

Net change 3+ year tags

blend_dat <- prep_net_3(blend_dat)
net_change_plot(blend_dat)

All Clusters

Overall change among repeat schools (2+ years)

merge_deep <- prep_overall(dat, deeper, repeaters_2, tots_2) %>% 
  mutate(cluster = "Deeper learning")
merge_ed_justice <- prep_overall(dat, ed_justice, repeaters_2, tots_2) %>% 
  mutate(cluster = "Educational justice")
merge_individualized <- prep_overall(dat, individualized, repeaters_2, tots_2) %>% 
  mutate(cluster = ("Individualized learning"))
merge_postsecondary <- prep_overall(dat, postsecondary, repeaters_2, tots_2) %>% 
  mutate(cluster = "Postsecondary pathways")
merge_none <- prep_overall(dat, none, repeaters_2, tots_2) %>% 
  mutate(cluster = "No cluster")
merge_blended <- prep_overall(dat, blended_tags, repeaters_2, tots_2) %>% 
  mutate(cluster = "Blended learning (alternate)")
all_clust <- bind_rows(merge_deep, merge_ed_justice, merge_individualized, merge_postsecondary, merge_none, merge_blended)
all_clust %>% 
  ggplot(., aes(year, pct)) +
  geom_line(aes(group = label), color = "gray", alpha = 0.5) + 
  geom_point(aes(group = label), color = "gray", alpha = 0.5, size = 1) + 
  geom_smooth(se = FALSE, method = "lm", color = "cornflowerblue", aes(group = 1)) + 
  theme_bw() +
  scale_x_continuous(breaks = unique(all_clust$year)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), legend.position = "none") +
  facet_wrap(~cluster) +
  labs(x = "", y = "Rate of selection")

rm(merge_deep, merge_ed_justice, merge_individualized, merge_postsecondary, merge_none, merge_blended)

Overall change among repeat schools (2+ years) using stable tags (3+ years)

all_clust %>% 
  filter(var %in% rep_tags) %>% 
  ggplot(., aes(year, pct)) +
  geom_line(aes(group = label), color = "gray", alpha = 0.5) + 
  geom_point(aes(group = label), color = "gray", alpha = 0.5, size = 1) + 
  geom_smooth(se = FALSE, method = "lm", color = "cornflowerblue", aes(group = 1)) + 
  theme_bw() +
  scale_x_continuous(breaks = unique(all_clust$year)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), legend.position = "none") +
  facet_wrap(~cluster) +
  labs(x = "", y = "Rate of selection")

Net change

merge_deep <- deep %>% 
  select(year, var, label, norm_net) %>% 
  mutate(cluster = "Deeper learning") %>% 
  group_by(year, cluster) %>% 
  summarize(cum_norm_net = mean(norm_net)) %>% 
  ungroup()
merge_ed_justice <- justice_dat %>% 
  select(year, var, label, norm_net) %>% 
  mutate(cluster = "Educational Justice") %>% 
  group_by(year, cluster) %>% 
  summarize(cum_norm_net = mean(norm_net)) %>% 
  ungroup()
merge_individualized <- ind_dat %>% 
  select(year, var, label, norm_net) %>% 
  mutate(cluster = "Individualized learning") %>% 
  group_by(year, cluster) %>% 
  summarize(cum_norm_net = mean(norm_net)) %>% 
  ungroup()
merge_postsecondary <- post_dat %>% 
  select(year, var, label, norm_net) %>% 
  mutate(cluster = "Postsecondary pathways") %>% 
  group_by(year, cluster) %>% 
  summarize(cum_norm_net = mean(norm_net)) %>% 
  ungroup()
merge_none <- none_dat %>% 
  select(year, var, label, norm_net) %>% 
  mutate(cluster = "No cluster") %>% 
  group_by(year, cluster) %>% 
  summarize(cum_norm_net = mean(norm_net)) %>% 
  ungroup()
merge_blended <- blend_dat %>% 
  select(year, var, label, norm_net) %>% 
  mutate(cluster = "Blended learning (alternate)") %>% 
  group_by(year, cluster) %>% 
  summarize(cum_norm_net = mean(norm_net)) %>% 
  ungroup()
all_clust <- bind_rows(merge_deep, merge_ed_justice, merge_individualized, merge_postsecondary, merge_none, merge_blended) %>% 
  rename("norm_net" = cum_norm_net) %>% 
  group_by(cluster) %>% 
  mutate(cum_norm_net = mean(norm_net)) %>% 
  ungroup() %>% 
  mutate(type = case_when(
         cum_norm_net == max(cum_norm_net) ~ "Largest net change over time",
         cum_norm_net == min(cum_norm_net) ~ "Smallest net change over time",
         TRUE ~ "Average net change"
        ),
        type = factor(type, levels = c("Largest net change over time", "Smallest net change over time", "Average net change")),
        label = cluster) %>% 
  rename("var" = cluster)
net_change_plot(all_clust)
rm(merge_blended, merge_deep, merge_individualized, merge_postsecondary, merge_ed_justice, merge_none)

Net change (excluding alternate blended learning cluster)

all_clust <- all_clust %>% 
  filter(var != "Blended learning (alternate)") %>% 
  mutate(max_cum = max(cum_norm_net),
           min_cum = min(cum_norm_net)) %>% 
  group_by(var) %>% 
  mutate(type = case_when(
         max_cum == cum_norm_net ~ "Largest net change over time",
         min_cum == cum_norm_net ~ "Smallest net change over time",
         TRUE ~ "Average net change"),
         type = factor(type, levels = c("Largest net change over time", "Smallest net change over time", "Average net change")))
net_change_plot(all_clust)

Net change (static version with labels)

palette <- c("#6cac8c", "#ff6f69","#d3d3d3")
static <- all_clust %>% 
  filter(var != "Blended learning (alternate)") %>% 
  ungroup() %>% 
  mutate(max_cum = max(cum_norm_net),
         min_cum = min(cum_norm_net),
         label = case_when(
           year != 2024 ~ NA,
           TRUE ~ as.character(label)
         )) %>% 
  group_by(var) %>% 
  mutate(type = case_when(
         max_cum == cum_norm_net ~ "Largest net change over time",
         min_cum == cum_norm_net ~ "Smallest net change over time",
         TRUE ~ "Average net change"),
         type = factor(type, levels = c("Largest net change over time", "Smallest net change over time", "Average net change")),
         x_coord = 2024.5,
         y_coord = norm_net[which.max(year)]) %>% 
  ungroup()
ggplot(static, aes(year, norm_net, color = type, group = var, text = label)) +
  geom_line(alpha = 0.8) +
  geom_point(alpha = 0.5, size = 1) +
  scale_color_manual(values = palette) +
  theme_bw() +
  theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), legend.position = "none") +
  scale_x_continuous(expand = expansion(mult = c(0, .25))) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(x = "", y = "Normalized net change",
       subtitle = "Values above the dashed line indicate growth. Values below the dashed line indicate decline.") +
  geom_hline(aes(yintercept = 0), size = .25, linetype = "dashed") +
  geom_text_repel(data = static,
                  aes(label = label, x = 2024, y = y_coord),
                  nudge_x = 0.05,
                  direction = "y",
                  hjust = 0,
                  size = 4,
                  point.padding = 1)
## Warning: Removed 15 rows containing missing values (`geom_text_repel()`).

First version graphs

Across schools

Graph #1 looks at selection of tags across our whole sample, i.e., the number reflects the percentage of our total sample of schools that selected each tag. (AKA across schools)

One of the questions we were hoping to investigate with this graph is whether the selection of blended learning tags may be due to changes in our survey design through the introduction of parent/child tags. We do see a sharp decrease in child tags in 2023. However, the selection for the parent tag blended learning remains high. All school leaders that selected blended learning would have received a follow-up question about the type of blended learning they use with our child tags listed below. This makes me think that schools are still using blended learning, but perhaps did not see their approach to blended learning reflected in our child tags. (So what are they using…?)

blended <- dat %>% 
  filter(var %in% blended_tags) %>%
  group_by(var, year) %>% 
  summarize(n = sum(usage)) %>% 
  ungroup()
tots <- dat %>% 
  group_by(year) %>% 
  summarize(total = n_distinct(school_id)) %>% 
  unique()
blended <- blended %>% 
  left_join(tots, by = "year") %>% 
  mutate(pct = n/total) %>% 
  left_join(labels, by = "var")
#build plot
#palette colors
palette <- c("#BC2582", "#FFA630","#FFDE42","#99C24D","#218380","#D3B7D7")
#labels
labs <- blended %>% 
  filter(year == 2024) %>% 
  select(label, x = year, y = pct)
#plot
blended %>% 
  ggplot(aes(year, pct, color = label)) +
  geom_point() +
  geom_line() +
  theme_bw() +
  scale_color_manual(values = palette) +
  scale_x_continuous(expand = expansion(mult = c(.025, .3))) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme(legend.position = "none") +
  geom_text(data = labs, 
            aes(label = label, 
                x = x, 
                y = y),
            hjust = -.05)

Across schools (no COVID)

What if we omit 2021 to account for the big jump?

blended <- dat %>% 
  filter(var %in% blended_tags) %>%
  filter(year != 2021) %>% 
  group_by(var, year) %>% 
  summarize(n = sum(usage)) %>% 
  ungroup() %>% 
  left_join(tots, by = "year") %>% 
  mutate(pct = n/total) %>% 
  left_join(labels, by = "var")

#plot
blended %>% 
  ggplot(aes(year, pct, color = label)) +
  geom_point() +
  geom_line() +
  theme_bw() +
  scale_color_manual(values = palette) +
  scale_x_continuous(expand = expansion(mult = c(.025, .3))) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme(legend.position = "none") +
  geom_text(data = labs, 
            aes(label = label, 
                x = x, 
                y = y),
            hjust = -.05)

Within schools

Graph #2 looks at the rate of change for blended learning tags only among schools that participated for 2 or more years. (AKA within schools)

#key for participating schools 2+ times
repeaters <- dat %>% 
  select(school_id, year) %>% 
  unique() %>% 
  mutate(rate = 1) %>% 
  pivot_wider(names_from = "year",
              values_from = "rate") %>% 
  rowwise() %>% 
  mutate(participate = sum(`2019`, `2021`, `2022`, `2023`, na.rm = TRUE)) %>% 
  filter(participate > 1) %>% 
  pull(school_id)
#data
blended <- dat %>% 
  #filter only blended tags
  filter(var %in% blended_tags) %>% 
  #filter only repeat schools
  filter(school_id %in% repeaters) %>% 
  #create wave variable
  arrange(school_id, year) %>% 
  group_by(school_id) %>%
  mutate(wave = dense_rank(year)) %>% 
  ungroup() %>% 
  #create change column
  arrange(school_id, year) %>%
  group_by(school_id, var) %>%
  mutate(change = usage - lag(usage)) %>% 
  ungroup() %>% 
  #create add/drop columns
  mutate(adds = ifelse(change == 1, 1, NA),
         drops = ifelse(change == -1, 1, NA)) %>% 
  #create totals
  group_by(var, year) %>% 
  summarize(`Overall rate` = sum(usage, na.rm = TRUE),
            `Average change` = sum(change, na.rm = TRUE),
            Adds = sum(adds, na.rm = TRUE),
            Drops = sum(drops, na.rm = TRUE)) %>% 
  ungroup() %>% 
  #pivot for plotting
  pivot_longer(cols = c(`Overall rate`, `Average change`, Adds, Drops),
               names_to = "type",
               values_to = "n") %>% 
  #labels for plotting
  left_join(labels, by = "var") %>% 
  #order for plotting
  mutate(type = factor(type, levels = c("Overall rate", "Average change", "Adds", "Drops")))

#palette for plot
palette <- c("gray80", "#f1c1af", "#6bd497", "#b94c4c")
#plot
blended %>% 
  ggplot(aes(year, n, color = type)) +
  geom_point() +
  geom_line() +
  theme_bw() +
  scale_color_manual(values = palette) +
  scale_x_continuous(expand = expansion(mult = c(.025, .3))) +
  theme(panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank()) +
  theme(legend.position = "bottom") +
  facet_wrap(~label) +
  labs(x = "Year",
       y = "Tag selection (N)",
       color = "Rate of change")

Within schools (no COVID)

Again, what if we omit 2021?

#data
blended <- dat %>% 
  #filter only blended tags
  filter(var %in% blended_tags) %>% 
  #filter only repeat schools
  filter(school_id %in% repeaters) %>% 
  #drop 2021 year
  filter(year != 2021) %>% 
  #create wave variable
  arrange(school_id, year) %>% 
  group_by(school_id) %>%
  mutate(wave = dense_rank(year)) %>% 
  ungroup() %>% 
  #create change column
  arrange(school_id, year) %>%
  group_by(school_id, var) %>%
  mutate(change = usage - lag(usage)) %>% 
  ungroup() %>% 
  #create add/drop columns
  mutate(adds = ifelse(change == 1, 1, NA),
         drops = ifelse(change == -1, 1, NA)) %>% 
  #create totals
  group_by(var, year) %>% 
  summarize(`Overall rate` = sum(usage, na.rm = TRUE),
            `Average change` = sum(change, na.rm = TRUE),
            Adds = sum(adds, na.rm = TRUE),
            Drops = sum(drops, na.rm = TRUE)) %>% 
  ungroup() %>% 
  #pivot for plotting
  pivot_longer(cols = c(`Overall rate`, `Average change`, Adds, Drops),
               names_to = "type",
               values_to = "n") %>% 
  #labels for plotting
  left_join(labels, by = "var") %>% 
  #order for plotting
  mutate(type = factor(type, levels = c("Overall rate", "Average change", "Adds", "Drops")))

#plot
blended %>% 
  ggplot(aes(year, n, color = type)) +
  geom_point() +
  geom_line() +
  theme_bw() +
  scale_color_manual(values = palette) +
  scale_x_continuous(expand = expansion(mult = c(.025, .3))) +
  theme(panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank()) +
  theme(legend.position = "bottom") +
  facet_wrap(~label) +
  labs(x = "Year",
       y = "Tag selection (N)",
       color = "Rate of change")

2023 Drop Investigation

Investigating drop in blended learning tags in 2023.

From CW: Could you do a quick tally of: a) how many schools in 2022 chose any of the child tags WITHOUT choosing “blended learning”

There were 21 instances where a school leader chose child tags but did not choose blended learning.

dat %>% 
  filter(year == 2022) %>% 
  filter(var %in% blended_tags) %>% 
  pivot_wider(names_from = "var",
              values_from = "usage") %>% 
  group_by(school_id) %>% 
  mutate(children = case_when(
    practices_a_la_carte == 1 ~ 1,
    practices_flex == 1 ~ 1,
    practices_flipped_classroom == 1 ~ 1,
    practices_enriched_virtual == 1 ~ 1,
    practices_station_rotation == 1 ~ 1,
    TRUE ~ 0
  ),
  childless = case_when(
    practices_blended_learning == 1 & children == 0 ~ 1,
    TRUE ~ 0
  ),
  parentless = case_when(
    practices_blended_learning == 0 & children == 1 ~ 1,
    TRUE ~ 0
  )) %>% 
  ungroup() %>% 
  summarize(selected_children = sum(parentless),
            selected_parent_only = sum(childless)) %>% 
  datatable()
  1. how many schools in 2023 chose “blended learning” as a parent tag but didn’t choose any child tags?

There were 53 instances where a school leader chose blended learning but did not choose one of the child tags. (And 94 instances where they did choose child tags, for comparison.)

dat %>% 
  filter(year == 2023) %>% 
  filter(var %in% blended_tags) %>% 
  pivot_wider(names_from = "var",
              values_from = "usage") %>% 
  group_by(school_id) %>% 
  mutate(children = case_when(
    practices_a_la_carte == 1 ~ 1,
    practices_flex == 1 ~ 1,
    practices_flipped_classroom == 1 ~ 1,
    practices_enriched_virtual == 1 ~ 1,
    practices_station_rotation == 1 ~ 1,
    TRUE ~ 0
  ),
  childless = case_when(
    practices_blended_learning == 1 & children == 0 ~ 1,
    TRUE ~ 0
  )) %>% 
  ungroup() %>% 
  summarize(selected_parent = sum(childless),
            selected_children = sum(children)) %>% 
  datatable()

Models

#clean up environment
rm(cluster, deep, justice_dat, tots, tots_2, tots_3, tots_all)
#create new cluster DV
mod_dat <- dat %>% 
  #add cluster groups
  mutate(cluster = case_when(
    var %in% deeper ~ "deeper",
    var %in% ed_justice ~ "ed_justice",
    var %in% individualized ~ "individualized",
    var %in% postsecondary ~ "postsecondary",
    var %in% none ~ "misc"
  ),
  year = factor(year)) %>% 
  #note: clusters only outlined for 2024 tags... do we want to modify?
  #for now, drop missing cluster
  filter(!is.na(cluster)) %>% 
  #generate cluster percentage for each school
  group_by(cluster, year, school_id) %>% 
  summarize(total = n_distinct(var),
            n = sum(usage),
            pct = n/total) %>% 
  select(school_id, year, cluster, n, pct) %>% 
  ungroup() %>% 
  pivot_wider(names_from = cluster,
              values_from = c(n, pct))
#read in characteristic vars for modeling and merge
vars <- import(here("data/longitudinal", "longitudinal_data.csv")) %>% 
  select(school_id, year, school_type, school_locale, school_enrollment, pct_bipoc, pct_ell, pct_frpl, pct_swd, grades_pk, grades_elementary, grades_middle, grades_high) %>% 
  mutate(c_enrollment = scale(school_enrollment, center = TRUE, scale = TRUE)[,1],
         c_bipoc = scale(pct_bipoc, center = TRUE, scale = TRUE)[,1],
         c_ell = scale(pct_ell, center = TRUE, scale = TRUE)[,1],
         c_frpl = scale(pct_frpl, center = TRUE, scale = TRUE)[,1],
         c_swd = scale(pct_swd, center = TRUE, scale = TRUE)[,1],
         year = factor(year)) %>% 
  select(-c(school_enrollment, starts_with("pct")))
#merge
mod_dat <- mod_dat %>% 
  left_join(vars, by = c("school_id", "year"))
# set vars of interest
dv <- mod_dat %>% select(starts_with("n_")) %>% colnames()
preds <- mod_dat %>% select(-school_id, -starts_with("pct_"), -starts_with("n_")) %>% colnames()

Poisson

#run models
model_list <- list()

for (outcome in dv) {
  formula <- as.formula(paste(dv, "~", paste(preds, collapse = "+")))
  model <- glm(formula, data = mod_dat, family = "poisson")
  model_list[[outcome]] <- model
}
## Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
##   Consider formula(paste(x, collapse = " ")) instead.

## Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
##   Consider formula(paste(x, collapse = " ")) instead.

## Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
##   Consider formula(paste(x, collapse = " ")) instead.

## Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
##   Consider formula(paste(x, collapse = " ")) instead.

## Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
##   Consider formula(paste(x, collapse = " ")) instead.
#extract coeffs
tidy_models <- list()

for (outcome in names(model_list)) {
  tidy_model <- tidy(model_list[[outcome]])
  tidy_model$outcome <- outcome
  tidy_models[[outcome]] <- tidy_model
}

#combine
plot_data <- do.call(rbind, tidy_models) %>% 
  #rename outcome
  mutate(outcome = case_when(
    outcome == "n_deeper" ~ "Deeper learning",
    outcome == "n_ed_justice" ~ "Educational justice",
    outcome == "n_individualized" ~ "Individualized learning",
    outcome == "n_postsecondary" ~ "Postsecondary pathways",
    outcome == "n_misc" ~ "Misc. cluster"
  ),
  #rename terms
  term = str_remove_all(term, "school_type"),
  term = str_remove_all(term, "grades_"),
  term = str_remove_all(term, "c_"),
  term = str_remove_all(term, "school_locale")
  ) %>% 
  arrange(desc(estimate)) %>% 
  mutate(term = fct_inorder(term))
#prep data
plot_data_list <- list()

for (outcome in names(model_list)) {
  tidy_model <- tidy(model_list[[outcome]], conf.int = TRUE)
  tidy_model$outcome <- outcome 
  plot_data_list[[outcome]] <- tidy_model
}

#create plot for each outcome
create_plot_for_outcome <- function(data, outcome) {
  data <- data %>% 
    filter(term != "(Intercept)")
  
  ggplot(data, aes(y = fct_reorder(term, estimate), x = estimate)) +
    geom_linerange(aes(xmin = estimate - std.error, 
                       xmax = estimate + std.error), 
                   color = "blue") +
    geom_point() +
    theme_minimal() +
    theme(panel.grid.major.y = element_blank()) +
    labs(
      x = "Estimated effect on cluster",
      y = "",
      title = sprintf("School characteristics describing %s", outcome)
    )
}

plots <- list()
for (outcome in names(plot_data_list)) {
  plots[[outcome]] <- create_plot_for_outcome(plot_data_list[[outcome]], outcome)
}
plots$n_deeper

plots$n_ed_justice

plots$n_individualized

plots$n_misc

plots$n_postsecondary

Binomial logistic regression

This approach seems to make more sense for the structure of our data and given that the max number of practices in a cluster changes over time for educational justice, postsecondary, and misc. clusters (thanks for the insight, Gregor!). As in previous years, I’ve adjusted our estimates so we can read them as likelihood–values above 1 indicate a characteristic that made a school more likely to select a tag and vice versa. For interpretation of time, I made the year following COVID our reference year so we can see whether the likelihood of selection changed on either side of this time point. For interpretation of school type, I’ve made district schools our reference point. For locale, I’ve made urban schools our reference point.

#check that upper limit for each cluster corresponds to total
#add cluster n's for cbind()
log_dat <- mod_dat %>% 
  mutate(tot_deeper = 12, #consistent every year; total = 12
         tot_ed_justice = 19, # 10 in 2019; 15 in 2021 & 2022; 19 in 2023 & 2024
         tot_individualized = 9, #consistent every year; total = 9
         tot_misc = 24, #14 in 2019; 18 in 2021; 21 in 2022; 23 in 2023; 24 in 2024
         tot_postsecondary = 9, #5 in 2019; 7 in 2021 & 2022; 9 in 2023 & 2024
         max_deeper = 12,
         max_ed_justice = case_when(
           year == 2019 ~ 10,
           year == 2021 | year == 2022 ~ 15,
           year == 2023 | year == 2024 ~ 19
         ),
         max_individualized = 9,
         max_misc = case_when(
           year == 2019 ~ 14,
           year == 2021 ~ 18,
           year == 2022 ~ 21,
           year == 2023 ~ 23,
           year == 2024 ~ 24
         ),
         max_postsecondary = case_when(
           year == 2019 ~ 5,
           year == 2021 | year == 2022 ~ 7,
           year == 2023 | year == 2024 ~ 9
         )) %>% 
  pivot_longer(cols = c(starts_with("n_"), starts_with("pct_"), starts_with("tot_"), starts_with("max_")),
               names_to = c(".value", "cluster"),
               names_pattern = "^([^_]+)_(.*)$") %>% 
  rowwise() %>% 
  mutate(success = n,
         failure = max - n,
         year = factor(year, levels = c(2021, 2019, 2022, 2023, 2024)),
         school_type = factor(school_type, levels = c("Public district school", "Public charter school", "Independent (private) school")),
         school_locale = factor(school_locale, levels = c("Urban", "Suburban", "Rual", "Multiple")))

Deeper learning

Schools were more likely to select deeper learning tags in years following COVID. Private schools, high schools, and schools with above average proportions of students with disabilities were more likely to select deeper learning tags.

#manual run because loops aren't working - deeper learning
deep <- log_dat %>% 
  filter(cluster == "deeper") %>% 
  filter(!if_any(all_of(preds), is.na))
deep_mod <- glm(cbind(success, failure) ~ year + school_type + school_locale + grades_pk + grades_elementary + grades_high + c_enrollment + c_bipoc + c_ell + c_frpl + c_swd,
                family = binomial,
                data = deep)
# plot
tidy(deep_mod, effects = "ran_pars", conf.int = TRUE) %>%
  filter(term != "(Intercept)") %>%
  mutate(estimate = exp(estimate)) %>% 
ggplot(., aes(y = fct_reorder(term, estimate), x = estimate)) +
  geom_linerange(aes(xmin = estimate - std.error,
                     xmax = estimate + std.error),
                 color = "blue") +
  geom_point() +
  geom_vline(xintercept = 1) +
  theme_minimal() +
  theme(panel.grid.major.y = element_blank()) +
  labs(
    x = "Likelihood",
    y = "",
    title = "School characteristics predicting deeper learning")

Educational justice

Charter schools, private schools, and schools with above average proportions of BIPOC students and students with disabilities were more likely to select tags in the educational justice cluster. Schools were also more likely to select these practices in 2022, immediately following COVID, but less likely to select these practices in more recent years. Rural schools were less likely to select these practices.

#manual run because loops aren't working - educational justice
ed_justice <- log_dat %>% 
  filter(cluster == "ed_justice") %>% 
  filter(!if_any(all_of(preds), is.na))
ed_justice_mod <- glm(cbind(success, failure) ~ year + school_type + school_locale + grades_pk + grades_elementary + grades_high + c_enrollment + c_bipoc + c_ell + c_frpl + c_swd + offset(log(max)),
                family = binomial,
                data = ed_justice)
# plot
tidy(ed_justice_mod, effects = "ran_pars", conf.int = TRUE) %>%
  filter(term != "(Intercept)") %>%
  mutate(estimate = exp(estimate)) %>% 
  ggplot(., aes(y = fct_reorder(term, estimate), x = estimate)) +
  geom_linerange(aes(xmin = estimate - std.error,
                     xmax = estimate + std.error),
                 color = "blue") +
  geom_point() +
  geom_vline(xintercept = 1) +
  theme_minimal() +
  theme(panel.grid.major.y = element_blank()) +
  labs(
    x = "Estimated effect on cluster",
    y = "",
    title = "School characteristics describing educational justice")

Individualized learning

Private schools and schools serving suburban or multiple geographic areas are more likely to select individualized learning tags. It appears these tags were most likely to be selected in the 2021 COVID year, as every year since shows decreased likelihood relative to that year.

#manual run because loops aren't working - individualized learning
individualized <- log_dat %>% 
  filter(cluster == "individualized") %>% 
  filter(!if_any(all_of(preds), is.na))
individualized_mod <- glm(cbind(success, failure) ~ year + school_type + school_locale + grades_pk + grades_elementary + grades_high + c_enrollment + c_bipoc + c_ell + c_frpl + c_swd,
                family = binomial,
                data = individualized)
# plot
tidy(individualized_mod, effects = "ran_pars", conf.int = TRUE) %>%
  filter(term != "(Intercept)") %>%
  mutate(estimate = exp(estimate)) %>% 
ggplot(., aes(y = fct_reorder(term, estimate), x = estimate)) +
    geom_linerange(aes(xmin = estimate - std.error,
                       xmax = estimate + std.error),
                   color = "blue") +
    geom_point() +
    theme_minimal() +
  geom_vline(xintercept = 1) +
    theme(panel.grid.major.y = element_blank()) +
    labs(
      x = "Estimated effect on cluster",
      y = "",
      title = "School characteristics describing individualized learning")

Postsecondary pathways

Whether or not a school is a high school was, by far, the most important characteristic that explained their selection of postsecondary pathway tags. High schools were 4x as likely to select postsecondary pathway tags.

#manual run because loops aren't working - postsecondary
postsecondary <- log_dat %>% 
  filter(cluster == "postsecondary") %>% 
  filter(!if_any(all_of(preds), is.na))
postsecondary_mod <- glm(cbind(success, failure) ~ year + school_type + school_locale + grades_pk + grades_elementary + grades_high + c_enrollment + c_bipoc + c_ell + c_frpl + c_swd + offset(log(max)),
                family = binomial,
                data = postsecondary)
# plot
tidy(postsecondary_mod, effects = "ran_pars", conf.int = TRUE) %>%
  filter(term != "(Intercept)") %>%
  mutate(estimate = exp(estimate)) %>% 
ggplot(., aes(y = fct_reorder(term, estimate), x = estimate)) +
    geom_linerange(aes(xmin = estimate - std.error,
                       xmax = estimate + std.error),
                   color = "blue") +
    geom_point() +
  geom_vline(xintercept = 1) +
    theme_minimal() +
    theme(panel.grid.major.y = element_blank()) +
    labs(
      x = "Estimated effect on cluster",
      y = "",
      title = "School characteristics describing postsecondary pathways")

Misc.

I ran this one just to see if there were certain types of schools that characterized our miscellaneous cluster. It seems to be mostly private/charter high schools. Not sure if there’s much to say about it since it was out “catch-all” cluster.

#manual run because loops aren't working - misc
misc <- log_dat %>% 
  filter(cluster == "misc") %>% 
  filter(!if_any(all_of(preds), is.na))
misc_mod <- glm(cbind(success, failure) ~ year + school_type + school_locale + grades_pk + grades_elementary + grades_high + c_enrollment + c_bipoc + c_ell + c_frpl + c_swd + offset(log(max)),
                family = binomial,
                data = misc)
# plot
tidy(misc_mod, effects = "ran_pars", conf.int = TRUE) %>%
  filter(term != "(Intercept)") %>%
  mutate(estimate = exp(estimate)) %>% 
ggplot(., aes(y = fct_reorder(term, estimate), x = estimate)) +
    geom_linerange(aes(xmin = estimate - std.error,
                       xmax = estimate + std.error),
                   color = "blue") +
    geom_point() +
  geom_vline(xintercept = 1) +
    theme_minimal() +
    theme(panel.grid.major.y = element_blank()) +
    labs(
      x = "Estimated effect on cluster",
      y = "",
      title = "School characteristics describing tags without a cluster")